home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 005 / tfbook.arc / BOOK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-10-14  |  8.7 KB  |  304 lines
  1. (* Program to take an ASCII file from the TF program and print a nice
  2.    readable phone directory suitable for use in a small loose-leaf
  3.    notebook. Also can be used to print Roladex cards.
  4.  
  5.    Original: 09/23/86   By: J. Eric Slone   *)
  6.  
  7. {$U+,C+}
  8.  
  9. type bookrec = record
  10.                    firstname  :string[15];
  11.                    lastname   :string[30];
  12.                    company    :string[40];
  13.                    address1   :string[40];
  14.                    address2   :string[40];
  15.                    telephone  :string[15];
  16.                    exten      :string[5];
  17.                    remark1    :string[40];
  18.                    remark2    :string[40];
  19.                    remark3    :string[40];
  20.                end;
  21.      bookfiletype = file of bookrec;
  22.  
  23. var  null, ans, last          :char;
  24.      blank, i, ind, numb,
  25.      results, ppage           :integer;
  26.      bookfile                 :bookfiletype;
  27.      entry                    :bookrec;
  28.  
  29. (* Uses Turbo Pascal Database Toolkit Quick Sort. *)
  30.  
  31. {$I SORT.BOX }
  32.  
  33. (* Convert the ASCII file to a record-type file so that it can be properly
  34.    read in. Sloppy, but it needs to be here. This should be fixed some day
  35.    and added to the read in procedure. *)
  36.  
  37. procedure addcr;
  38. type io = record
  39.                 fn :string[15];
  40.                 ln :string[30];
  41.                 co :string[40];
  42.                 a1 :string[40];
  43.                 a2 :string[40];
  44.                 tn :string[15];
  45.                 ex :string[5];
  46.                 r1 :string[40];
  47.                 r2 :string[40];
  48.                 r3 :string[40];
  49.           end;
  50. var infile                    :text;
  51.     fn, tn                    :string[15];
  52.     ln                        :string[30];
  53.     co, a1, a2, r1, r2, r3    :string[40];
  54.     ex                        :string[5];
  55.     outfile                   :file of io;
  56.     temp                      :io;
  57. begin
  58.      assign (infile, 'book');
  59.      assign (outfile, 'book.prn');
  60.      {$I+}
  61.      reset (infile);
  62.      {$I-}
  63.      if ioresult<>0 then
  64.      begin
  65.           clrscr;
  66.           writeln ('ERROR - BOOK NOT IN CURRENT DIRECTORY');
  67.           halt;
  68.      end;
  69.      {$I+}
  70.      rewrite (outfile);
  71.      {$I-}
  72.      if ioresult<>0 then
  73.      begin
  74.           clrscr;
  75.           writeln ('ERROR - BOOK.PRN CANNOT BE OPENED');
  76.           halt;
  77.      end;
  78.      while not eof (infile) do
  79.      begin
  80.           read (infile, fn);
  81.           read (infile, ln);
  82.           read (infile, co);
  83.           read (infile, a1);
  84.           read (infile, a2);
  85.           read (infile, tn);
  86.           read (infile, ex);
  87.           read (infile, r1);
  88.           read (infile, r2);
  89.           readln (infile, r3);
  90.           temp.fn:=fn;
  91.           temp.ln:=ln;
  92.           temp.co:=co;
  93.           temp.a1:=a1;
  94.           temp.a2:=a2;
  95.           temp.tn:=tn;
  96.           temp.ex:=ex;
  97.           temp.r1:=r1;
  98.           temp.r2:=r2;
  99.           temp.r3:=r3;
  100.           write (outfile, temp);
  101.      end;
  102.      close (infile);
  103.      close (outfile);
  104. end;
  105.  
  106. (* Input the data to be sorted and printed. *)
  107.  
  108. procedure inp;
  109. var rec   :integer;
  110. begin
  111.      rec:=0;
  112.      repeat
  113.            rec:=rec+1;
  114.            read (bookfile, entry);
  115.            sortrelease (entry);
  116.      until eof (bookfile);
  117. end;
  118.  
  119. (* Define the sort order. *)
  120.  
  121. function less;
  122. var firsttype  :bookrec absolute x;
  123.     secondtype :bookrec absolute y;
  124. begin
  125.      less:=firsttype.lastname<secondtype.lastname;
  126. end;
  127.  
  128. (* Issue a form-feed to the printer. *)
  129.  
  130. procedure form;
  131. var k       :integer;
  132. begin
  133.      k:=12;
  134.      writeln (LST, chr(k));
  135. end;
  136.  
  137. (* Indent a number of spaces while printing. *)
  138.  
  139. procedure indent;
  140. var x       :integer;
  141. begin
  142.      for x:=1 to ind do
  143.          write (LST, null);
  144. end;
  145.  
  146. (* Output the data to the printer.
  147.  
  148.    rev 10/14/86  Added page break on new beginning letter in last name *)
  149.  
  150. procedure outp;
  151. var i  :integer;
  152. begin
  153.      last:=' ';
  154.      numb:=0;
  155.      repeat
  156.            sortreturn (entry);
  157.            with entry do
  158.            begin
  159.                 if lastname[1]<>last then
  160.                 begin
  161.                      form;
  162.                      last:=lastname[1];
  163.                      writeln (LST, last, '---------');
  164.                 end
  165.                    else
  166.                 writeln (LST, '----------');
  167.                 if keypressed then halt;
  168.                 indent;
  169.                 writeln (LST, firstname, ' ', lastname);
  170.                 if company[1]<>' ' then
  171.                 begin
  172.                      indent;
  173.                      writeln (LST, company);
  174.                 end;
  175.                 if address1[1]<>' ' then
  176.                 begin
  177.                      indent;
  178.                      writeln (LST, address1);
  179.                 end;
  180.                 if address2[1]<>' ' then
  181.                 begin
  182.                      indent;
  183.                      writeln (LST, address2);
  184.                 end;
  185.                 writeln (LST, ' ');
  186.                 indent;
  187.                 writeln (LST, telephone, ' Ext: ', exten);
  188.                 writeln (LST, ' ');
  189.                 if remark1[1]<>' ' then
  190.                 begin
  191.                      indent;
  192.                      writeln (LST, remark1);
  193.                 end;
  194.                 if remark2[1]<>' ' then
  195.                 begin
  196.                      indent;
  197.                      writeln (LST, remark2);
  198.                 end;
  199.                 if remark3[1]<>' ' then
  200.                 begin
  201.                      indent;
  202.                      writeln (LST, remark3);
  203.                 end;
  204.                 numb:=numb+1;
  205.                 if numb=ppage then
  206.                 begin
  207.                      numb:=0;
  208.                      form;
  209.                 end;
  210.           end;
  211.      until sorteos;
  212. end;
  213.  
  214. (* The opening screen. Also, set the indent and records-per-page variables.
  215.  
  216.    rev 10/14/86  Stopped form feed with each test pattern
  217.                  Fixed spacing  *)
  218.  
  219. procedure opening;
  220. begin
  221.      clrscr;
  222.      writeln ('PHONE BOOK PRINTING PROGRAM FOR THE TF PHONE DATABASE PROGRAM');
  223.      writeln;
  224.      writeln ('Version 1.21 10/14/86');
  225.      writeln;
  226.      writeln ('Written by: J. Eric Slone');
  227.      writeln ('            2523 Wilson Boulevard #3');
  228.      writeln ('            Arlington, VA 22201');
  229.      writeln;
  230.      writeln ('This program is in the public domain.');
  231.      writeln;
  232.      writeln;
  233.      writeln ('DIRECTIONS: Save your phone directory by using F5 from the');
  234.      writeln ('            TF program. You should name the ASCII file BOOK. After');
  235.      writeln ('            exiting TF, run this program. A sorted record-type file');
  236.      writeln ('            named BOOK.PRN will be created containing all records');
  237.      writeln ('            sorted by last name. When printing, make sure that your');
  238.      writeln ('            printer is in the correct font and lines-per-inch mode.');
  239.      writeln ('            You can print the test pattern as many times as needed to');
  240.      writeln ('            achieve this setting. The length of the test line represents');
  241.      writeln ('            the maximum characters that will be printed on a line by');
  242.      writeln ('            this program. ');
  243.      writeln;
  244.      write ('PRESS ANY KEY TO CONTINUE...');
  245.      while not keypressed do
  246.           null:=' ';
  247.      clrscr;
  248.      writeln ('PHONE BOOK PRINTING PROGRAM FOR THE TF PHONE DATABASE PROGRAM');
  249.      writeln;
  250.      writeln;
  251.      writeln ('Version 1.21  10/14/86  J. Eric Slone');
  252.      writeln;
  253.      writeln;
  254.      ind:=4;
  255.      ans:='y';
  256.      while ans in ['y', 'Y'] do
  257.      begin
  258.           gotoxy (1, 15);
  259.           write ('Indent spaces [RETURN=', ind, ']: ');
  260.           readln (ind);
  261.           if (ind<=0) or (ind>10) then ind:=4;
  262.           writeln;
  263.           write ('Print a test pattern? [Y/N] ');
  264.           readln (ans);
  265.           if ans in ['y', 'Y'] then
  266.           begin
  267.                indent;
  268.                writeln (LST, '++++|++++1++++|++++2++++|++++3++++|++++4++++|+');
  269.           end;
  270.      end;
  271.      writeln;
  272.      writeln;
  273.      write ('Number of entries per page [1 5/8" per entry]: ');
  274.      readln (ppage);
  275.      writeln;
  276.      writeln ('PRESS CONTROL-BREAK TO ABORT PRINTING');
  277.      writeln;
  278. end;
  279.  
  280. (* The main program. *)
  281.  
  282. begin
  283.      opening;
  284.      addcr;
  285.      assign (bookfile, 'book.prn');
  286.      {$I+}
  287.      reset (bookfile);
  288.      {$I-}
  289.      if ioresult<>0 then
  290.      begin
  291.           clrscr;
  292.           writeln ('ERROR - BOOK.PRN NOT IN CURRENT DIRECTORY');
  293.           halt;
  294.      end;
  295.      results:=turbosort (sizeof(bookrec));
  296.      if results<>0 then
  297.      begin
  298.           halt;
  299.           writeln;
  300.           writeln;
  301.           writeln ('A SORT ERROR HAS OCCURED');
  302.      end;
  303.      erase (bookfile);
  304. end.